home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / ai.prl / mike1.exe / UTIL.PL < prev    next >
Encoding:
Text File  |  1990-07-14  |  26.9 KB  |  767 lines
  1. /* file: UTIL.PL {writel etc., tracing, history, describe, strategy, show} */
  2. /*                          *************
  3.                                M I K E
  4.                             *************
  5.                Micro Interpreter for Knowledge Engineering
  6.                   {written in Edinburgh-syntax Prolog}
  7.  
  8. MIKE: Copyright (c) 1989, 1990 The Open University (U.K.)
  9.  
  10. MIKE is intended for educational purposes, and may not
  11. be sold as or incorporated in a commercial product without
  12. written permission from: The Copyrights Officer, Open University,
  13. Milton Keynes MK7 6AA, U.K.
  14.  
  15. The Open University accepts no responsibility for any legal or other
  16. consequences which may arise directly or indirectly as a result of the
  17. use of all or parts of the contents of this program.
  18.  
  19. This software accompanies Open University Study Pack PD624, 'KNOWLEDGE
  20. ENGINEERING'.  Complete sets of study pack materials may be obtained from:
  21.  
  22.                       Learning Materials Sales Office
  23.                       The Open University
  24.                       P.O. Box 188
  25.                       Milton Keynes MK7 6DH, U.K.
  26.  
  27.                       Tel: [+44] (908) 653338
  28.                       Fax: [+44] (908) 653744
  29. */
  30. /* Utilities for MIKE */
  31. /* mainly tracing and formatting information */
  32.  
  33. /* If you are porting MIKE to another PROLOG then pay particular attention
  34.    to this file.  If the PROLOG to which you are porting has the built in
  35.    primitive 'append' then you may well have to comment the definition of
  36.    it in this file.  It is assumed that the PROLOG you are using has a
  37.    built-in definition of 'abolish'.  If you are porting to LPA MacProlog
  38.    then also remove the definition of 'kill' below.  */
  39. /* This file is divided into three main sections:
  40.      1.  simple utilities, such as 'pd624 member'
  41.      2.  tracing facilities
  42.      3.  the utilities 'describe', 'strategy', and 'show'
  43. */
  44. /* =================== (1) SIMPLE UTILITIES ============================= */
  45.  
  46. kill(_). /* for compatibility with LPA MacPROLOG, dummy definition needed */
  47.  
  48. /* ---  'pd624 member'(X, [X|_]). is to avoid any name clashes with existing
  49.          definitions of member */
  50.  
  51. 'pd624 member'(X,[X|_]).
  52. 'pd624 member'(X, [_|Xs]) :-
  53.     'pd624 member'(X, Xs).
  54.  
  55. do_just_once(X) :-
  56.     call(X),
  57.     !.            
  58.  
  59. append([],L,L).
  60. append([H|L1],L2,[H|L3]):-
  61.     append(L1,L2,L3).
  62.  
  63. /* definition of union and intersection (commented out), just in case...
  64.  
  65. union([],Ys,Ys).
  66. union([X|Xs], Ys, Zs) :-
  67.    member(X,Ys),
  68.    !,
  69.    union(Xs,Ys,Zs).
  70. union([X|Xs], Ys, [X|Zs]) :-
  71.    union(Xs,Ys,Zs).
  72.  
  73. intersection([],Ys,[]).
  74. intersection([X|Xs], Ys, [X|Zs]) :-
  75.    member(X,Ys),
  76.    !,
  77.    intersection(Xs,Ys,Zs).
  78. intersection([X|Xs],Ys,Zs) :-
  79.    intersection(Xs,Ys,Zs).
  80.  
  81. */
  82.  
  83.  
  84. 'pd624 subset'([],X):- nonvar(X).
  85. 'pd624 subset'([H|T],Target):-
  86.     'pd624 member'(H,Target),
  87.     'pd624 subset'(T,Target).
  88.  
  89. 'pd624 & member'(A,A).
  90. 'pd624 & member'(A,A & _).
  91. 'pd624 & member'(A,_ & B):-
  92.     'pd624 & member'(A,B).
  93.  
  94. 'pd624 list length'([],0).
  95. 'pd624 list length'([A|List],Length):-
  96.    'pd624 list length'(List,Length1),
  97.    Length is Length1 + 1.
  98.  
  99. /* 'pd624 length with disjunct check' sees if there is a disjunct in the
  100.    pattern.  If there is it will take the first disjunct (in left to right
  101.    sequence) and it will compute the specificity in terms of the specificity
  102.    of either side of the disjunct and then choose the highest.  All other
  103.    disjuncts will be ignored */
  104. 'pd624 length with disjunct check'(A or B,L):-
  105.        'pd624 length'(A,L1),
  106.        'pd624 length'(B,L2),
  107.        (L1 >= L2,L1 = L;L2 = L),!.
  108. 'pd624 length with disjunct check'(A,B):-
  109.        'pd624 length'(A,B).
  110.  
  111. 'pd624 length'(A or B,N):-
  112.    'pd624 length'(A,N1),
  113.    'pd624 length'(B,N2),
  114.    N is N1 + N2.
  115. 'pd624 length'(_ & T,N):-
  116.     'pd624 length'(T,N1),
  117.     N is 1 + N1.
  118. 'pd624 length'(A,1).
  119.  
  120. /* A tailor-made 'quicksort' for triples of the form (S,I,T),
  121.    (these are the three arguments of enabled, used elsewhere in
  122.    this file).
  123.    S (Switch) is an integer, and triples need to be sorted
  124.    into ascending numerical order.  */
  125. 'pd624 sort'([],[]).
  126. 'pd624 sort'([(S,I,T)|SITs],Sorted) :-
  127.        'pd624 split'(SITs,S,Los,His),
  128.        'pd624 sort'(Los, SortedLos),
  129.        'pd624 sort'(His, SortedHis),
  130.        append(SortedLos, [(S,I,T)|SortedHis], Sorted).
  131.  
  132. 'pd624 split'([],_,[],[]).
  133. 'pd624 split'([(S,I,T)|SITs],Crit,[(S,I,T)|Los],His) :-
  134.        S < Crit,
  135.        'pd624 split'(SITs,Crit,Los,His).
  136. 'pd624 split'([(S,I,T)|SITs],Crit,Los,[(S,I,T)|His]) :-
  137.        S >= Crit,
  138.        'pd624 split'(SITs,Crit,Los,His).
  139.  
  140. /* ---- writel and other output routines -------------- */
  141. writel([]).
  142. writel([(rule Name forward if Ifs then Thens)|Rest]):-
  143.     write('rule '),write(Name),write(' forward '),nl,tab(6), write(' if '),
  144.     nl,tab11_write(Ifs),nl,tab(6),write(' then '),nl,
  145.     tab11_write(Thens),write('. '),nl,
  146.     writel(Rest),!.
  147. writel([(rule Name backward if Ifs then Thens)|Rest]):-
  148.     write('rule '),write(Name),write(' backward '),nl,tab(6), write(' if '),
  149.     nl,tab11_write(Ifs),nl,tab(6),write(' then '),nl,
  150.     tab11_write(Thens),write('. '),nl,
  151.     writel(Rest),!.
  152. writel([nl|R]):-
  153.     nl, writel(R).
  154. writel([t/Tab|Rest]):-
  155.     tab(Tab),
  156.     writel(Rest).
  157. writel([&|Rest]):-
  158.       write(' & '),
  159.         writel(Rest).
  160. writel(A:[H|[]]):-
  161.  tab(6),write(A),write(' : '),write(' ['),
  162.  write(H),write(']').
  163. writel(A:[H|T]):-
  164.     tab(6),write(A),write(' : '),write(' ['),
  165.  write(H),write(','),nl,
  166.     write1(T), write(']').
  167. writel(A:B):-
  168.     tab(6),write(A),write(' : '),write(B).
  169. writel([H|T]):-
  170.     write(H),nl,
  171.     writel(T).
  172. writel((A,B)):- /* conjunct, but for MIKE this means 'with' Body */
  173.     writel(A), write(','),nl,
  174.     writel(B).
  175. writel(A):-
  176.     tab(12),write(A),nl.
  177.  
  178. write1([X]) :-
  179.     tab(20),write(X).
  180. write1([]).
  181. write1([X|[]]):-
  182.  tab(20),write(X).
  183. write1([H|T]):-
  184.     tab(20),write(H),write(','),
  185.     nl,write1(T).
  186.  
  187. conj_write((A&B)) :- write(A),write(' & '),conj_write(B), !.
  188. conj_write(X) :- write(X).
  189.  
  190. tab11_write((A or B)):-
  191.     !,
  192.     tab11_write(A),     nl,
  193.     tab(6),write('or '), nl,
  194.     tab11_write(B).
  195. tab11_write((H & T)):-
  196.     !,
  197.     tab(11),write(H),write(' & '),nl,tab11_write(T).
  198. tab11_write(H):-
  199.     tab(11),write(H).
  200.  
  201. 'pd624 write'([]).
  202. 'pd624 write'([nl|B]):-!, nl,'pd624 write'(B).
  203. 'pd624 write'([tab(A)|B]):- !,tab(A),'pd624 write'(B).
  204. 'pd624 write'([t/A|B]):- !,tab(A),'pd624 write'(B).
  205. 'pd624 write'([A|B]):-!, write(A),'pd624 write'(B).
  206. 'pd624 write'([nl]):-nl.
  207. 'pd624 write'([tab(L)]):-tab(L).
  208. 'pd624 write'([t/L]):-tab(L).
  209. 'pd624 write'([A]):- write(A).
  210.  
  211. 'pd624 pretty list'([]).
  212. 'pd624 pretty list'([nl|B]):- !,nl,'pd624 pretty list'(B).
  213. 'pd624 pretty list'([tab(A)|B]):- !,tab(A),'pd624 pretty list'(B).
  214. 'pd624 pretty list'([t/A|B]):- !,tab(A),'pd624 pretty list'(B).
  215. 'pd624 pretty list'([A|B]):- !,tab(1),write(A),'pd624 pretty list'(B).
  216. 'pd624 pretty list'([nl]):-nl.
  217. 'pd624 pretty list'([tab(L)]):-tab(L).
  218. 'pd624 pretty list'([t/L]):-tab(L).
  219. 'pd624 pretty list'([A]):- tab(1),write(A).
  220.  
  221. /* ========================== (2)  T R A C I N G ======================= */
  222. /* tracing is normally called with no arguments, in which case it prompts
  223.    the user with a menu of choices.  With a single integer argument,
  224.    just that option is 'toggled' (i.e. turned from off to on, or on to off).
  225.    Optional syntax is: tracing([N1,N2,N3,...]), where N1 etc. are integers
  226.    from 1 to 10 specifying the number of the tracing option you wish
  227.    to 'toggle' */
  228.  
  229. tracing([]).
  230. tracing([X|Xs]) :-  /* list of integers expected */
  231.   tracing(X),
  232.   tracing(Xs).
  233. tracing(X):- change_options(X),   /* single integer expected */
  234.  enabled(I,T,X),
  235.  write_options([(X,I,T)]).
  236.  
  237. tracing:-            /* this is the normal usage */
  238.    display_tracing_options,
  239.       !,
  240.    'pd624 write'(['Type the numbers of the option you wish to change',nl,
  241.       ' eg. 1,2,3,4. and then a FULL STOP',nl,
  242.       'Or quit. to exit without altering the settings',nl]),
  243.     write('==> '),
  244.     read(Input),
  245.     change_options(Input),
  246.     display_tracing_options,
  247.     'pd624 write'(['Type',nl,'  ?- show symbols.',nl,
  248.                   'for a reminder of what the tracing symbols mean.',nl]).
  249.  
  250.  
  251. display_tracing_options :-
  252.     findall((S,I,T),(enabled(I,T,S), \+ 'pd624 member'(S,[11,12,13,14,15]))
  253.                ,Newoptions_unsorted),
  254.     'pd624 sort'(Newoptions_unsorted,Newoptions),
  255.     write_options(Newoptions),nl.
  256.  
  257. change_options((A,B)):- /* conjunction of options? deal with head then tail */
  258.      !,
  259.   change_options(A),
  260.         change_options(B).
  261. change_options(9):-   /* options 13,14,15 are 'yoked' with number 9 */
  262.     enabled(A,' disabled ',9),
  263.     reverse_option(A,enable),
  264.   change_options((13,14,15)), !.
  265. change_options(9):-
  266.  enabled(A,' enabled ',9),
  267.     reverse_option(A,disable),
  268.  change_options((13,14,15)), !.
  269. change_options(A):-           /* normal case: singleton option */
  270.     enabled(Name,' disabled ',A),
  271.     reverse_option(Name,enable),
  272.  !.
  273. change_options(A):-
  274.     enabled(Name,' enabled ',A),
  275.     reverse_option(Name,disable),
  276.  !.
  277. change_options(quit):- !. /* normal way to bail out of tracing options... */
  278. change_options(q):- !.    /* but we also allow 'q', 'exit', 'e', 'ok', 'halt' */
  279. change_options(exit):- !. /* as un-documented alternatives */
  280. change_options(e):- !.
  281. change_options(ok):- !.
  282. change_options(halt):- !.
  283. change_options(A) :-
  284.     writel([A,' is an illegal option',nl,'legal options are numbers that',
  285.                 'appear in the tracing menu. ']),!.
  286.  
  287.  
  288. reverse_option(Name,disable):-
  289.     retract(enabled(Name,_,A)),
  290.     assert(enabled(Name,' disabled ',A)),
  291.     !.
  292. reverse_option(Name,enable):-
  293.     retract(enabled(Name,_,A)),
  294.     assert(enabled(Name,' enabled ',A)),
  295.     !.
  296. reverse_option(A,_):-
  297.     writel([A,' is an illegal option',nl,'legal options are numbers that',
  298.                 'appear in the tracing menu. ']),!.
  299.  
  300. turn_off_option(A):-  /* like change, but unconditionally turns off or
  301.                          else leaves it alone if it was already off */
  302.     enabled(Name,' enabled ',A),
  303.     reverse_option(Name,disable).
  304. turn_off_option(_).
  305.  
  306. write_options([]).
  307. write_options([(Index,Item,S)|T]):-
  308.     write_plus_or_minus(S,Index),write(Index),write(': '),write(Item),
  309.     write(' is currently'),write(S),write('. '),nl,
  310.     write_options(T).
  311. write_options([A|B]):-
  312.     write('ERROR: from write options'),
  313.     write(A),nl,
  314.     write_options(B).
  315.  
  316. write_plus_or_minus(' disabled ', N) :-
  317.    write('-'), (N < 10, write(' ') ; true), !.
  318.  
  319. write_plus_or_minus(_, N) :-
  320.    write('+'), (N < 10, write(' '); true), !.
  321.  
  322. when_enabled(P for List):-
  323.     enabled(P,' enabled ',_ignore_the_index), /* flag enabled? */
  324.     !,
  325.     P for List.    /* then call P (e.g. 'show outcome for backward chain..') */
  326.                    /* if P can be re-satisfied on backtracking, this is fine */
  327. when_enabled(P for List) :-
  328.     enabled(P,' disabled ',_), !. /* i.e. do nothing if flag disabled */
  329. when_enabled(X) :-
  330.    writel(['Warning: when_enabled/1 has been passed an unexpected argument:',
  331.           X,nl,'  Only the authorised tracing flags are allowed!',
  332.    'These are the ones displayed when you type:  ?- tracing.',
  333.    '[Succeeding anyway, which may cause extra solutions to be found!]']).
  334.  
  335. /* enabled/3 is just a database of flags, using the following 3 arguments:
  336.    1  The name of the option
  337.    2  Its current state, either ' enabled ' or ' disabled '
  338.    3  An integer indicating its position in the tracing multiple-choice menu.
  339. */
  340. enabled('show conflict set',' disabled ',1).
  341. enabled('show refractoriness',' disabled ',2).
  342. enabled('show specificity',' disabled ',3).
  343. enabled('show recency',' disabled ',4).
  344. enabled('show new working memory elements or frame changes',' disabled ',5).
  345. enabled('show chosen rule',' disabled ',6).
  346. enabled('show backward chaining',' disabled ',7).
  347. enabled('show outcome of backward chaining',' disabled ',8).
  348. enabled('show single stepping',' disabled ',9).
  349. enabled('show history on request',' enabled ',10).
  350.  
  351. /* the next five options are set internally at run-time, and are not
  352.    meant to be settable by the user!! */
  353.  
  354. enabled('show individual LHS in', ' disabled ',11).
  355. enabled('show individual LHS out', ' disabled ',12).
  356. enabled('show single stepping in', ' disabled ',13).
  357. enabled('show single stepping out', ' disabled ',14).
  358. enabled('show conflict winner', ' disabled ',15).
  359.  
  360. 'show outcome of backward chaining' for P/Depth:-  /* success */
  361.       enabled('show backward chaining',' enabled ',7),
  362.          write('<- '),tab(Depth),write('+ '),conj_write(P),nl.
  363. 'show outcome of backward chaining' for P/Depth:-  /* only come here on retry */
  364.          write('<- '),tab(Depth), write('^ '),conj_write(P),nl,
  365.       !,
  366.       fail.  /* because we need to propagate failure back to older sibling */
  367. 'show backward chaining' for P/Depth:-  /* goal invocation */
  368.   do_just_once((Depth = 0, nl ; true)), /* extra newline only for first call */
  369.   write('<- '),tab(Depth),write('? '),conj_write(P),nl.
  370. 'show conflict set' for P:-
  371.     nl,write('Conflict Set is: '),nl,
  372.     writel(P).
  373. 'show refractoriness' for P :-
  374.     nl,write('Refractoriness filter threw out the following rule: '),nl,
  375.     writel(P).
  376. 'show specificity' for P:-
  377.     nl,write('Conflict set AFTER specificity filter is: '), nl,
  378.     writel(P).
  379. 'show new working memory elements or frame changes' for P :-
  380.     nl,write('New working memory elements or frame changes are: '), nl,
  381.     writel(P).
  382. 'show recency' for P:-
  383.     nl,write('Conflict set AFTER recency filter is: '), nl,
  384.     writel(P).
  385. 'show chosen rule' for P:-
  386.     nl,write('Chosen rule is: '), nl,
  387.     writel(P).
  388.  
  389. 'show individual LHS in' for X :-
  390.               write('-LHS-> '),write('? '),write(X),
  391.               pd624_read_loop,
  392.               !.
  393.  
  394. 'show individual LHS out' for X :-
  395.               write('-LHS-> '),write('+ '), write(X),nl,
  396.               !.
  397.  
  398. 'show single stepping in' for X :-
  399.               turn_off_option(11),   /* kill creeping in, regardless */
  400.               turn_off_option(12),  /* kill creeping out, regardless */
  401.               nl,write('-> ? '),write(X),ulnl,
  402.               pd624_read_loop,
  403.               !.      /* because embedded within a findall */
  404.  
  405. 'show single stepping out' for X :-
  406.               write('   +'),   /* many instantiations may win here! */
  407.               !.
  408.  
  409. 'show conflict winner' for X:-
  410.               nl,write('-> * '),write(X),write(' ************'),
  411.               ulnl,
  412.               pd624_read_loop,
  413.               !.
  414.  
  415. 'show history on request' for [RuleName,Symbol] :-
  416.       'pd624 current cycle is'(CycleNum),
  417.        assertz('pd624 fc_history'(RuleName,CycleNum,Symbol)),
  418.        !.
  419.  
  420. /* ------------ Forward chaining history display ------------------------ */
  421. history(_,_) :-
  422.   enabled('show history on request',' disabled ',_),
  423.   !,
  424.   writel(['To see the history of execution in tabular form, you must FIRST',
  425.           'ensure that the tracing option called ''show history on request'' has been enabled',
  426.           '(this is necessary because the history has to be stored during execution).',
  427.           'To enable the relevant option, you can either type',
  428.           '    ?- tracing(10).',
  429.           'or else',
  430.           '    ?- tracing.',
  431.           'and then respond appropriately to the menu of choices.',nl,
  432.           'When you have set your options correctly, you can then reinvoke',
  433.           '    ?- fc.',
  434.           'and then type',
  435.           '    ?- show history.',
  436.           'when execution has completed.']).
  437.  
  438. history(beginning, end) :-  /* default case passed in from ?- show history. */
  439.    'pd624 current cycle is'(SoFar),
  440.    SoFar > 45,
  441.    'pd624 write'([
  442.      'The highest cycle number reached on the preceding run was: ',SoFar,nl,
  443.  'You can display the history for any contiguous group of up to 45 cycles',nl,
  444.  'by entering a modified version of the show history command.',nl,
  445.  'For example, to see cycles 30 to 55, say, you would type in', nl,
  446.  '  ?- show history/30-55.',nl]).
  447.  
  448. history(beginning, end) :-   /* constants are deliberate 'flags' */
  449.    'pd624 current cycle is'(SoFar),
  450.    SoFar < 46,
  451.    SoFar > 0,
  452.    history(1,SoFar),  /* this invokes the 'legitimate' output below */
  453.    !.
  454.  
  455. history(beginning, end) :-   /* constants are deliberate 'flags' */
  456.    'pd624 current cycle is'(0),
  457.    nl,
  458.    write('No history to show you yet!  Try: ?- fc.'),
  459.    nl,
  460.    !.
  461.  
  462. history(Lo,Hi) :-
  463.    integer(Lo),
  464.    integer(Hi),
  465.    Diff is Hi - Lo,
  466.    Diff > 44,
  467.    'pd624 current cycle is'(SoFar),
  468.    'pd624 write'(['Sorry, you can only display 45 cycles at a time.',nl,
  469.  'Try   ?- show history.  to see the first 45 cycles,',nl,
  470.  'or    ?- show history/40-85. to see cycles 40 to 85, etc.',nl,
  471.  'The highest cycle number reached on the preceding run was: ',SoFar,nl]),
  472.    !,
  473.    fail.
  474.  
  475. history(Lo, Hi) :-
  476.    integer(Lo),
  477.    integer(Hi),
  478.    !,
  479.    'pd624 write'([nl,'  RULE NAME                           CYCLE NUMBER(',
  480.                  Lo,'-',Hi,')',nl]),
  481.    'pd624 generate listofnums'(Lo,Hi,WholeList),
  482.    tab(30),posh_dots(WholeList),nl,
  483.    findall(Name,((rule Name forward if X then Y)),AllNames),
  484.    'pd624 fc_history display'(AllNames,WholeList).
  485.  
  486. history(A,B) :-
  487.    'pd624 write'(['Sorry, only integer values are allowed, e.g.', nl,
  488.                   '  ?- show history/40-85. ', nl]),
  489.    !,
  490.    fail.
  491.  
  492. posh_dots([]).
  493. posh_dots([N|Ns]) :-
  494.    posh_symbol(N,Sym),
  495.    write(Sym),
  496.    posh_dots(Ns).
  497.  
  498. posh_symbol(N, Int) :-
  499.   0 is N mod 10,  /* multiple of 10?  then use integer from 1 to 9  */
  500.   !,
  501.   posh_truncate(N, Int).
  502.  
  503. posh_symbol(N, ':') :-  /* use : for multiples of 5, e.g.  ....:....1....: */
  504.   0 is N mod 5,
  505.   !.
  506.  
  507. posh_symbol(N, '.').  /* default case... just use a dot */
  508.  
  509. posh_truncate(N, Int) :-
  510.     Temp is N//10,
  511.     Int is Temp mod 10.
  512.  
  513. 'pd624 fc_history display'([Rule|Rules],NumList) :-
  514.     'pd624 show name'(Rule),
  515.     'pd624 fc_history gimme one line'(Rule, NumList),
  516.     'pd624 fc_history display'(Rules,NumList).
  517.  
  518. 'pd624 fc_history display'([],_) :- nl.  /* termination */
  519.  
  520. 'pd624 show name'(RuleName) :-
  521.        'pd624 string length'(RuleName,Len),
  522.        'pd624 maybe truncate name'(RuleName,Len).
  523.  
  524. 'pd624 maybe truncate name'(Name,Len) :-
  525.        Len > 30,                /* very long name? */
  526.        write(Name),nl,tab(30).  /* then insert <CR>, tab across */
  527.  
  528. 'pd624 maybe truncate name'(Name,Len) :-
  529.        Len =< 30,              /* name length < 30 chars?  OK... */
  530.        Remainder is 30 - Len,  /* cause fc_history stuff starts at column 30 */
  531.        write(Name), tab(Remainder). /* write it out, tab the rest */
  532.  
  533. 'pd624 string length'(Atom, Length) :-
  534.        integer(Atom),       /* can only happen if you use rule name like 1 */
  535.        !,
  536.        'pd624 power_of_10'(Atom,Power),  /* e.g. 124 is 3 (3 digits) */
  537.        Length is Power + 1 .
  538.  
  539. /* COMPATIBILITY NOTE: THE CLAUSE WHICH FOLLOWS IS SPECIFIC TO THE
  540.    VERSION OF PROLOG SUPPLIED WITH PD624.  AN ALTERNATIVE DEFINITION
  541.    IS GIVEN A FEW LINES FURTHER ON. */
  542.  
  543.   'pd624 string length'(Atom,Length):-
  544.         name(Atom,String),
  545.         list(List,String),
  546.         'pd624 list length'(List,Length).
  547.  
  548. /* COMPATIBILITY NOTE ... THE FOLLOWING CODE CAN BE USED WITH
  549.    MOST EDINBURGH SYNTAX PROLOG DIALECTS, TO REPLACE THE IMMEDIATELY
  550.    PRECEDING CLAUSE. REARRANGE COMMENT BRACKETS ACCORDINGLY. */
  551.  
  552. /*
  553. 'pd624 string length'(Atom, Length) :-
  554.        name(Atom, List),
  555.        'pd624 list length'(List, Length).
  556.   */
  557.  
  558. 'pd624 power_of_10'(X,0) :- X < 10, !.
  559. 'pd624 power_of_10'(X,1) :- X < 100, !.
  560. 'pd624 power_of_10'(X,2) :- X < 1000, !.
  561. 'pd624 power_of_10'(X,3) :- X < 10000, !.
  562. 'pd624 power_of_10'(X,4) :- X < 100000, !.
  563. 'pd624 power_of_10'(X,5). /* This means that a rule named 123456789 will
  564.                              have a fixed string length of 6.  This
  565.                              will cause ?- show history. to print a
  566.                              slightly messed up chart.  The solution
  567.                              is to use numbers < 999999 for rule names! */
  568.  
  569.  
  570. 'pd624 fc_history gimme one line'(Rule,[]) :- nl.
  571. 'pd624 fc_history gimme one line'(Rule,[Num|Rest]) :-
  572.         /* if you have a symbol stored, write it out, else write ' ' */
  573.         'pd624 get best symbol'(Rule,Num,Sym),
  574.         write(Sym),
  575.         'pd624 fc_history gimme one line'(Rule,Rest).
  576.  
  577. 'pd624 get best symbol'(Rule,Num,'*') :-   /* strict priority sequence */
  578.         'pd624 fc_history'(Rule,Num,'*'),
  579.         !.
  580.  
  581. 'pd624 get best symbol'(Rule,Num,'+') :-
  582.        'pd624 fc_history'(Rule,Num,'+'),
  583.        !.
  584.  
  585. 'pd624 get best symbol'(Rule,Num,' '). /* no symbol, use blank */
  586.  
  587. 'pd624 generate listofnums'(X,Hi,[0]) :-
  588.        X > Hi,
  589.        write('Sorry, can only work with an ascending sequence of integers.'),
  590.        nl,
  591.        !,
  592.        fail.
  593.  
  594. 'pd624 generate listofnums'(Hi,Hi,[Hi]) :- !.
  595. 'pd624 generate listofnums'(Lo,Hi,[Lo|Rest]) :-
  596.        Next is Lo + 1,
  597.        'pd624 generate listofnums'(Next,Hi,Rest).
  598.  
  599.  
  600. /* ------------ handler for user input to single-stepper -------------- */
  601.  
  602. pd624_flag(dummy).  /* for MacProlog-like dialects & POPLOG, requiring 1 */
  603.  
  604. pd624_read_loop :-
  605.                not pd624_flag(unleashed),
  606.                get0(Char),
  607.                ((not Char = 13, get0(NextChar)) ; true),
  608.                pd624_deal_with(Char), !.
  609.  
  610. pd624_read_loop :-
  611.                pd624_flag(unleashed).
  612.  
  613. ulnl :-  /* unleashed new line */
  614.      pd624_flag(unleashed),
  615.      nl.
  616.  
  617. ulnl.
  618.  
  619. pd624_deal_with(97) :-  /* a for abort (does not really... ) */
  620.                    change_options(9),
  621.                    add halt. /* i.e. switch off stepper */
  622. pd624_deal_with(110) :- /* n for no-tracing */
  623.                    change_options(9). /* i.e. switch off stepper */
  624. pd624_deal_with(13).   /* <CR> */
  625. pd624_deal_with(98) :-  /* b for break */
  626.                    repeat,
  627.                    nl,write('MIKE ?- '),
  628.                    read(INPUT),
  629.                    (INPUT = quit;
  630.                     (do_just_once(call(INPUT)),
  631.                      do_just_once((write(INPUT);write(no))),
  632.                      fail) ).
  633.  
  634. pd624_deal_with(99) :- /* c for creep through left hand side conditions */
  635.          change_options(11),
  636.          change_options(12). /* toggles LHS creeping */
  637.  
  638. pd624_deal_with(117) :-  /* u for unleash */
  639.                     assert(pd624_flag(unleashed)).
  640.  
  641.  
  642. pd624_deal_with(HelpChar) :-
  643.                     (HelpChar = 63 ; HelpChar = 104),
  644.                     nl,nl,
  645.                     write('a(bort at end of the current interpreter cycle)'),nl,
  646.                     write('b(reak until quit)'),nl,
  647.                     write('c(reep through left-hand-side conditions)'),nl,
  648.                     write('h(elp)'),nl,
  649.                     write('n(o more tracing)'),nl,
  650.                     write('u(nleash)'),nl,
  651.                     write('<CR> = step'),nl,
  652.                     pd624_read_loop.
  653.  
  654. pd624_deal_with(_).
  655.  
  656.  
  657.  
  658. /* ======= (3)  D E S C R I B E ,  S T R A T E G Y , and  S H O W ====== */
  659. describe A:-
  660.     (A  instance_of Object with Body),
  661.     write(A instance_of Object),
  662.     write(' with '),
  663.     nl,writel(Body), write('.'), nl.
  664. describe A:-
  665.     (A  subclass_of Object with Body),
  666.     write(A subclass_of Object),
  667.     write(' with '),
  668.     nl,writel(Body), write('.'), nl.
  669. describe A:-
  670.  (rule A forward if Ifs then Thens),
  671.  writel([(rule A forward if Ifs then Thens)]).
  672. describe A:-
  673.  (rule A backward if Ifs then Thens),
  674.  writel([(rule A backward if Ifs then Thens)]).
  675.  
  676. strategy menu:-
  677.     current_conflict_resolution_strategy(List),
  678.     writel(['The current conflict resolution strategy is ',List,
  679.  
  680.            nl,'To change it, type the numbers that correspond to',
  681.         'the ordering that you want from the following menu',
  682.     ' e.g. if you want the ordering to be specificity, recency, refractoriness',
  683.     'then type 3,2,1.  <remember the FULL STOP!>',
  684.     '1 - refractoriness','2 - recency','3 - specificity']),
  685.     write('==>'),read(P),sort_out_options(P,List1),
  686.     retract(current_conflict_resolution_strategy(_)),
  687.     assert(current_conflict_resolution_strategy(List1)),
  688.     writel(['Ok, the new strategy is now ',List1,nl]).
  689.  
  690. strategy List:-
  691.     retract(current_conflict_resolution_strategy(P)),
  692.     assert(current_conflict_resolution_strategy(List)).
  693.     
  694. sort_out_options((A,B),[H|T]):-  !,
  695.     'pd624 member'((A,H),[(1,refractoriness),(2,recency),(3,specificity)]),
  696.     sort_out_options(B,T).
  697.  
  698. sort_out_options(A,[H]):-
  699.     'pd624 member'((A,H),[(1,refractoriness),(2,recency),(3,specificity)]).
  700.  
  701. /* ---------------- the show facility ------------------------- */
  702.  
  703. show history/Lo-Hi :-
  704.      history(Lo,Hi).
  705.  
  706. show history:-
  707.      history(beginning, end). /* this provides default output (see above) */
  708.  
  709. show wm :-
  710.      wm.
  711. show rules:-
  712.     'pd624 write'(['The currently loaded ruleset is ',
  713.     nl,'the following : ',nl]),
  714.     assert('wm counter'(0)),
  715.     ((rule X forward if _ then _);
  716.      (rule X backward if _ then _)),
  717.     do_just_once(('pd624 write'([t/5,X,nl]),
  718.                  retract('wm counter'(P)),
  719.                  New is P + 1,
  720.                  assert('wm counter'(New)))),
  721.     fail.
  722. show rules:-
  723.     retract('wm counter'(Number)),
  724.     'pd624 write'([nl,'A total of ',Number,
  725.      ' rules were found.',nl]).
  726.  
  727. show frames:-
  728.     'pd624 write'(['The currently loaded frames are ',
  729.     nl,'the following : ',nl]),
  730.     assert('wm counter'(0)),
  731.     ((A subclass_of _ with _X);
  732.      (A instance_of _ with _)),
  733.     do_just_once(('pd624 write'([t/5,A,nl]),
  734.                   retract('wm counter'(P)),
  735.                   New is P + 1,
  736.                   assert('wm counter'(New)))),
  737.     fail.
  738. show frames:-
  739.     retract('wm counter'(Number)),
  740.     'pd624 write'([nl,'A total of ',Number,
  741.      ' frames were found.',nl]).
  742.  
  743. show symbols :-
  744.    writel([
  745. 'SINGLE-STEP SYMBOL  |     MEANING (ASSUMES TRACING OPTION 9 IS SELECTED)',
  746. '->                     Forward chaining taking place',
  747. '-> ? <rule-name>       Considering this rule on forward chaining cycle',
  748. '   +                   The above (just-considered) rule enters conflict set',
  749. '   +   +   +   +       Four instantiations of above rule enter conflict set',
  750. '-> * <rule-name>       This rule alone has been selected for firing',
  751. '-LHS-> ? <pattern>     Considering this Left-Hand-Side pattern',
  752. '-LHS-> + <pattern>     This Left-Hand-Side pattern matched successfully',
  753. '<-                     Backward chaining taking place',
  754. '<- ? <pattern>         Trying to deduce this pattern',
  755. '<- + <pattern>         Pattern deduced successfully',
  756. '<- - <pattern>         Failed to deduce this pattern',
  757. '<- ^ <pattern>         Backtrack to find alternative proof for pattern',
  758. 'When the single-step tracer pauses you can type one of the following letters:',
  759. ' a(bort at end of the current interpreter cycle) - soon bails out',
  760. ' b(reak until quit) - invokes Prolog interpreter until you type ?- quit.',
  761. ' c(reep through left-hand-side conditions) - fine-grained -LHS-> trace',
  762. ' h(elp) - reminder of these symbols.   ?  has the same effect.',
  763. ' n(o more tracing) - suppresses extensive printout.',
  764. ' u(nleash) - no more pausing at each step, let loose extensive printout',
  765. ' <CR> = step through each rule (or LHS condition) as encountered.' ]).
  766.  
  767.